finp$="picture.png"

dim celcnt[8],plte[16]
dim bmapmm[8192],ikmm[768],pamm[768],hbmm[768]

plte[ 0]=0x000000:plte[ 1]=0x0000FF:plte[ 2]=0xFF0000:plte[ 3]=0xFF00FF
plte[ 4]=0x00FF00:plte[ 5]=0x00FFFF:plte[ 6]=0xFFFF00:plte[ 7]=0xFFFFFF
plte[ 8]=0x000000:plte[ 9]=0x0000DA:plte[10]=0xDA0000:plte[11]=0xDA00DA
plte[12]=0x00DA00:plte[13]=0x00DADA:plte[14]=0xDADA00:plte[15]=0xDADADA
hbl=0xDA:prl=128:bkl=10
setdisplay(256*4,192*2,32,1):paper(8^8-1):ink(0):pen(0):cls:loadimage(finp$,1):pasteicon(0,0,1)
for y1=0 to 23:for x1=0 to 31
    fbcnt=0
    for y2=0 to 7:for x2=0 to 7
        x=x1*8+x2:y=y1*8+y2
        u=point(x,y):b=bitwiseand(u,255):u=int(u/256):g=bitwiseand(u,255):u=int(u/256):r=bitwiseand(u,255)
        b1=0:r1=0:g1=0:fb=0:b2=b1:r2=r1:g2=g1
        if (r>=hbl or g>=hbl) or b>=hbl then:fb=1:end if
        if (r<bkl and g<bkl) and b<bkl then:fb=.5:end if
        fbcnt=fbcnt+fb
        if b>prl then:b1=255:b2=b1
          if fb=0 then:b1=hbl
            end if:end if
        if r>prl then:r1=255:r2=r1
          if fb=0 then:r1=hbl
            end if:end if
        if g>prl then:g1=255:g2=g1
          if fb=0 then:g1=hbl
            end if:end if
        ink(rgb(r1,g1,b1)):dot(256+x,y)
        ink(rgb(r2,g2,b2)):dot(768+x,y)
        next:next
    ink(rgb(hbl,hbl,hbl))
    if fbcnt>31.7 then:ink(0xFFFFFF):end if
    bar(512+x1*8,y1*8,512+x1*8+7,y1*8+7)
    next:next

for y1=0 to 23:for x1=0 to 31
    for i=0 to 7:celcnt[i]=(rnd(900))/1000:next
    for y2=0 to 7:for x2=0 to 7
        x=x1*8+x2:y=y1*8+y2
        u=point(768+x,y):b=bitwiseand(u,255):u=int(u/256):g=bitwiseand(u,255):u=int(u/256):r=bitwiseand(u,255)
        b1=0:r1=0:g1=0
        if b>prl then:b1=1:end if
        if r>prl then:r1=1:end if
        if g>prl then:g1=1:end if
        c3b=b1+(r1*2)+(g1*4)
        celcnt[c3b]=celcnt[c3b]+1
        next:next
    ikattr=0:paattr=0:ikcnt=0:pacnt=0
    for i=0 to 7:if ikcnt<celcnt[i] then:ikcnt=celcnt[i]:ikattr=i:end if:next
    celcnt[ikattr]=0
    for i=0 to 7:if pacnt<celcnt[i] then:pacnt=celcnt[i]:paattr=i:end if:next
    if ikattr>paattr then:tmpr=ikattr:ikattr=paattr:paattr=tmpr:end if
    ink(plte[ikattr]):bar(512+x1*8,192+y1*8,512+x1*8+7,192+y1*8+7):ikmm[y1*32+x1]=ikattr             
    ink(plte[paattr]):bar(768+x1*8,192+y1*8,768+x1*8+7,192+y1*8+7):pamm[y1*32+x1]=paattr
    hbflg=0:if bitwiseand(point(512+x1*8,y1*8),255)<240 then:hbflg=1:end if:hbmm[y1*32+x1]=hbflg
    next:next

'- le bitmap a partir da comparacao com a media
for y1=0 to 23:for x1=0 to 31
    y3=int(y1/8):y4=y1 mod 8
    hbflg=0:if bitwiseand(point(512+x1*8,y1*8),255)<240 then:hbflg=1:end if
    for y2=0 to 7
      btou=0
      for x2=0 to 7
        x=x1*8+x2:y=y1*8+y2
        u=point(768+x,y):b=bitwiseand(u,128)/128:u=int(u/256):g=bitwiseand(u,128)/128:u=int(u/256):r=bitwiseand(u,128)/128:pav1=(b)+(r*2)+(g*4)
        u=point(768+x,192+y):b=bitwiseand(u,128)/128:u=int(u/256):g=bitwiseand(u,128)/128:u=int(u/256):r=bitwiseand(u,128)/128:pav2=(b)+(r*2)+(g*4)
        u=point(512+x,192+y):b=bitwiseand(u,128)/128:u=int(u/256):g=bitwiseand(u,128)/128:u=int(u/256):r=bitwiseand(u,128)/128:pav3=(b)+(r*2)+(g*4)
        if pav1<(pav3+pav2)/2 then:
          ink(0x000000):dot(256+x,192+y)
          btou=btou+2^(7-x2)
          end if
        next
      bmapmm[ (x1)+(y3*2048)+(y2*256)+(y4*32) ]=btou
      next:next:next

for y1=0 to 23:for x1=0 to 31
    hbv=0:if bitwiseand(point(512+x1*8,y1*8),255)<240 then:hbv=1:end if
    u=point(512+x1*8,192+y1*8):b=bitwiseand(u,128)/128:u=int(u/256):g=bitwiseand(u,128)/128:u=int(u/256):r=bitwiseand(u,128)/128:pav=(b)+(r*2)+(g*4)
    u=point(768+x1*8,192+y1*8):b=bitwiseand(u,128)/128:u=int(u/256):g=bitwiseand(u,128)/128:u=int(u/256):r=bitwiseand(u,128)/128:ikv=(b)+(r*2)+(g*4)
    for y2=0 to 7:for x2=0 to 7
        ink(plte[pav+hbv*8])
        if bitwiseand(point(256+x2+(x1*8),192+y2+(y1*8)),128)/128<>0 then:ink(plte[ikv+hbv*8]):end if
        dot(x2+(x1*8),192+y2+(y1*8))
        next:next
    next:next

for i=0 to 767
  bmapmm[6144+i]=(pamm[i])*8+(ikmm[i])+(1-hbmm[i])*64
  next

open finp$+".scr" for output as #1
for i=0 to 6911
  writebyte(1,bmapmm[i])
  next
close #1

open finp$+".bas" for output as #1
print #1,"charmap01:"
print #1,"asm"
for j=0 to 6911 step 8
  a$="  defb 0"
  for k=0 to 7
    i=j+k
    a$=a$+hex$(bitwiseand(bmapmm[i],0xF0)/16)
    a$=a$+hex$(bitwiseand(bmapmm[i],0x0F))
    if k<7 then:a$=a$+"h,0":end if
    next
  a$=a$+"h":print #1,a$
  next
print #1,"  end asm"
close #1

grab(1,0,192,256,192):saveimage("_.bmp",1):shell("convert _.bmp "+finp$+"_.png && rm _.bmp")

'waitkey



